home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / tex / mf / inputs / dc / dxbase.mf < prev    next >
Text File  |  1994-04-12  |  58KB  |  1,488 lines
  1. % This is DXBASE.MF in text format, as of March 24, 1992
  2. %
  3. % DC fonts Version 1.1 (prerelease of EC fonts)
  4. %
  5. %          [ heavily borrowed from the Computer Modern Roman family of
  6. %            fonts by D. E. Knuth ]
  7. %
  8. % Content:
  9. %
  10. %   The base file needed for generation of the DC fonts
  11. %
  12. %
  13. % This is DXBASE.MF in text format, as of May 5, 1986.
  14. % The base file for Computer Modern (a supplement to {\tt plain.mf})
  15.  
  16. dxbase:=1; % when |dcbase| or |dxbase| is known, this file has been input
  17. dcbase:=1;
  18.  
  19. boolean classic_serif;  classic_serif := false;
  20. boolean suppress_i_dot; suppress_i_dot :=false;
  21.  
  22. let dcchar=\; % `|dcchar|' should precede each character
  23. let generate=input; % `|generate|' should follow the parameters
  24.  
  25. autorounding:=0; smoothing:=0; % we do our own rounding
  26. def autorounded = interim autorounding:=2 enddef;
  27.  
  28. newinternal slant,fudge,math_spread,superness,superpull,beak_darkness,ligs;
  29. boolean square_dots,hefty,serifs,
  30.  monospace,variant_g,low_asterisk,math_fitting;
  31.  
  32. boolean dark,dark.dark,skewed,skewed.skewed; % for fast option testing
  33. dark=skewed=false; dark.dark=skewed.skewed=true;
  34.  
  35. vardef Vround primary y = y_:=vround y;
  36.  if y_<min_Vround: min_Vround else: y_ fi enddef;
  37. newinternal y_,min_Vround;
  38.  
  39. vardef serif(suffix $,$$,@)  % serif at |z$| for stroke from |z$$|
  40.   (expr darkness,jut) suffix modifier =
  41.  pickup crisp.nib; numeric bracket_height; pair downward;
  42.  bracket_height=if dark.modifier: 1.5 fi\\ bracket;
  43.  if y$<y$$: y@2=min(y$+bracket_height,y$$);
  44.   top y@1-slab=bot y@0+eps=tiny.bot y$; downward=z$-z$$;
  45.   if y@1>y@2: y@2:=y@1; fi
  46.  else: y@2=max(y$-bracket_height,y$$);
  47.   bot y@1+slab=top y@0-eps=tiny.top y$; downward=z$$-z$;
  48.   if y@1<y@2: y@2:=y@1; fi fi
  49.  y@3=y@2; z@3=whatever[z$,z$$];
  50.  if jut<0: z@2+penoffset downward of currentpen =
  51.    z$l+penoffset downward of pen_[tiny.nib]+whatever*downward;
  52.   lft x@0=lft x@1=tiny.lft x$l+jut;
  53.   if x@3<x@2+eps: x@3:=x@2+eps; fi
  54.  else: z@2-penoffset downward of currentpen =
  55.    z$r-penoffset downward of pen_[tiny.nib]+whatever*downward;
  56.    rt x@0=rt x@1=tiny.rt x$r+jut;
  57.    if x@3>x@2-eps: x@3:=x@2-eps; fi fi
  58.  pair corner; ypart corner=y@1; corner=z@2+whatever*downward;
  59.  filldraw z@2{z$-z$$}
  60.   ...darkness[corner,.5[z@1,z@2] ]{z@1-z@2}
  61.   ...{jut,0}z@1--z@0--(x$,y@0)--z@3--cycle; % the serif
  62.  labels (@1,@2); enddef;
  63.  
  64. def dish_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  65.   (suffix @@)(expr right_darkness,right_jut) suffix modifier =
  66.  serif($,$$,@,left_darkness,-left_jut) modifier;
  67.  serif($,$$,@@,right_darkness,right_jut) modifier;
  68.  if dish>0: pickup tiny.nib; numeric dish_out,dish_in;
  69.   if y$<y$$: dish_out=bot y$; dish_in=dish_out+dish; let rev_=reverse;
  70.   else: dish_out=top y$; dish_in=dish_out-dish; let rev_=relax; fi
  71.   erase fill rev_
  72.    ((x@1,dish_out)..(x$,dish_in){right}..(x@@1,dish_out)--cycle);
  73.  fi enddef;
  74.  
  75. def nodish_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  76.   (suffix @@)(expr right_darkness,right_jut) suffix modifier =
  77.  serif($,$$,@,left_darkness,-left_jut) modifier;
  78.  serif($,$$,@@,right_darkness,right_jut) modifier; enddef;
  79.  
  80. vardef sloped_serif.l(suffix $,$$,@)(expr darkness,jut,drop) =
  81.  pickup crisp.nib; pos@2(slab,90);
  82.  lft x@0=tiny.lft x$l; rt x@1=tiny.rt x$r; top y@1=tiny.top y$r;
  83.  lft x@2=lft x@0-jut; y@2r=y@1-drop;
  84.  y@0=max(y@2l-bracket,y$$)-eps;
  85.  if drop>0: erase fill z@1--top z@1
  86.    --(x@2r,top y@1)--z@2r--cycle; fi % erase excess at top
  87.  filldraw z@1--z@2r--z@2l{right}
  88.   ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  89.   ...{down}z@0--(x@1,y@0)--cycle;  % sloped serif
  90.  labels(@0,@1,@2); enddef;
  91.  
  92. vardef sloped_serif.r(suffix $,$$,@)(expr darkness,jut,drop) =
  93.  pickup crisp.nib; pos@2(slab,-90);
  94.  rt x@0=tiny.rt x$r; lft x@1=tiny.lft x$l; bot y@1=tiny.bot y$l;
  95.  rt x@2=rt x@0+jut; y@2r=y@1+drop;
  96.  y@0=min(y@2l+bracket,y$$)+eps;
  97. if drop>0: erase fill z@1--bot z@1
  98.   --(x@2r,bot y@1)--z@2r--cycle; fi % erase excess at bottom
  99.  filldraw z@1--z@2r--z@2l{left}
  100.   ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  101.   ...{up}z@0--(x@1,y@0)--cycle;  % sloped serif
  102.  labels(@0,@1,@2); enddef;
  103.  
  104. vardef term.l(suffix $,$$)(expr d,t,s)= % ``robust'' sans-serif terminal
  105.  path p_; p_=z$l{d}..tension t..z$$l;
  106.  pair d_; d_=(x$$l-x$l,s*(y$$l-y$l));
  107.  if (abs angle direction 1 of p_ < abs angle d_)<>(x$l<x$$l):
  108.   p_:=z$l{d}..tension atleast t..{d_}z$$l; fi
  109.  p_ enddef;
  110. vardef term.r(suffix $,$$)(expr d,t,s)=
  111.  path p_; p_=z$r{d}..tension t..z$$r;
  112.  pair d_; d_=(x$$r-x$r,s*(y$$r-y$r));
  113.  if (abs angle direction 1 of p_ < abs angle d_)<>(x$r<x$$r):
  114.   p_:=z$r{d}..tension atleast t..{d_}z$$r; fi
  115.  p_ enddef;
  116. def rterm=reverse term enddef;
  117.  
  118. vardef arm(suffix $,$$,@)(expr darkness,jut) =  % arm from |z$| to |z$$|
  119.  x@0=good.x(x$$r-jut); y@0=y$r;
  120.  if serifs: y@1=y$l; z@1=z$$l+whatever*(z$$r-z@0);
  121.   z@2=.5[z$l,z@1];
  122.   filldraw z$$l{z@1-z$$l}...darkness[z@1,.5[z@2,z$$l] ]...z@2
  123.    ---z$l--z$r--z@0--z$$r--cycle; % arm and beak
  124.  else: filldraw z$l--z$r--z@0--z$$r--cycle; fi  % sans-serif arm
  125.  penlabels(@0,@1,@2); enddef;
  126.  
  127. def pi_stroke = pickup fine.nib;
  128.  pos1(hair,0); pos2(vstem,-90); pos3(vstem,-90);
  129.  x1-.5hair=hround -.5hair; x2=2u; x3=w-1.5u;
  130.  y1=x_height-x_height/3.141592653589793; y2=y3; top y3l=x_height;
  131.  filldraw circ_stroke z3e---z2e...{x1-x2,3.14159(y1-y2)}z1e enddef;
  132.  
  133. def eng_stroke(suffix $,@,@@,$$)(expr raise) =
  134.  penpos$$(x@@r-x@@l,0); x$$=x@@; bot y$$=.21h;
  135.  y@@=1/4[bar_height,x_height]+raise; % 1/3
  136.  penpos$''(x$r-x$l,0); x$''=x$;
  137.  y$''=1/8[bar_height,x_height]+raise;
  138.  filldraw stroke z$''e--z$e;  % thicken the lower left stem
  139.  penpos@0(min(rt x$r-lft x$l,thin_join)-fine,180); pickup fine.nib;
  140.  rt x@0l=tiny.rt x$r; y@0=y$'';
  141.  pos@1(vair,90); pos@@'(x@@r-x@@l+tiny,0); z@@'=z@@;
  142.  x@1=.5[rt x@0l,rt x@@'r];
  143.  top y@1r=x_height+oo+raise;
  144.  (x@,y@1l)=whatever[z@1r,z@0l]; x@1l:=x@;
  145.  filldraw stroke z@0e{up}...{right}z@1e
  146.   &{{interim superness:=hein_super; super_arc.e(@1,@@')}};  % arch
  147.  pickup tiny.nib; filldraw stroke z@@e--z$$e;  % right stem
  148.  labels(@0); penlabels(@1); enddef;
  149.  
  150.  
  151. def bulb(suffix $,$$,$$$) =
  152.  z$$$r=z$$r;
  153.  path_.l:=z$l{x$$r-x$r,0}...{0,y$$r-y$r}z$$l;
  154.  filldraw path_.l--z$$r{0,y$r-y$$r}...{x$r-x$$r,0}z$r--cycle; % link
  155.  path_.r:=z$$$l{0,y$r-y$$r}..z$$$r{0,y$$r-y$r}; % near-circle
  156.  filldraw subpath(0,xpart(path_.r intersectiontimes path_.l)) of path_.r
  157.   --z$$r{0,y$$r-y$r}..cycle; % bulb
  158.  enddef;
  159.  
  160. def v_bulb(suffix $,$$)= % |pos$| is known
  161.  y$$+.5curve=x_height+oo; x$$+.5curve=w-u;
  162.  numeric theta; theta=angle(4(x$-x$$),y$-y$$); pos$$(curve,theta+90);
  163.  filldraw z$$l{dir theta}..tension atleast 1 and 1..{down}z$l
  164.   --z$r{up}...{-dir theta}z$$r..cycle;  % bulb
  165.  enddef;
  166.  
  167. def dot(suffix $,$$) =
  168.  filldraw if square_dots: (x$l,y$$l)--(x$r,y$$l)
  169.    --(x$r,y$$r)--(x$l,y$$r)--cycle  % squarish dot
  170.   else: z$l...z$$l...z$r...z$$r...cycle  fi % roundish dot
  171.  enddef;
  172.  
  173. def comma(suffix $,@)(expr dot_size,jut,depth) =
  174.  pickup fine.nib; pos$(dot_size,90);
  175.  if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  176.   comma_join_:=max(fine.breadth,floor .7dot_size);
  177.   comma_bot_:=max(fine.breadth,floor .5dot_size);
  178.   pos@0(comma_join_,0); pos@1(comma_join_,0);
  179.   pos@2(comma_bot_,0); y@0=y$; y@1=y$l; y@2=y@1-depth;
  180.   x@0r=x@1r=x$'r; rt x@2r=good.x(x$-eps);
  181.   filldraw stroke z@0e--z@1e..z@2e;  % tail
  182.  else: pos@1(vair,90); pos@2(vair,0); pos@3(vair,-45);
  183.   z@1r=z$r; rt x@2r=hround(x$+.5dot_size+jut)+2eps; x@3=x$-.5u;
  184.   y@2=1/3[y@1,y@3]; bot y@3r=vround(y$-.5dot_size-depth);
  185.   y_:=ypart((z@1{right}...z@2{down}...z@3)
  186.    intersectiontimes (z$l{right}..{left}z$r)); if y_<0: y_:=1; fi
  187.   filldraw z$r{left}..subpath (0,y_) of (z$l{right}..{left}z$r)--cycle; % dot
  188.   filldraw stroke z@1e{right}...z@2e{down}...z@3e; fi  % tail
  189.  penlabels(@1,@2,@3); enddef;
  190.  
  191. def ammoc(suffix $,@)(expr dot_size,jut,depth) = % reversed comma
  192.  pickup fine.nib; pos$(dot_size,90);
  193.  if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  194.   comma_join_:=max(fine.breadth,floor .7dot_size);
  195.   comma_top_:=max(fine.breadth,floor .5dot_size);
  196.   pos@0(comma_join_,0); pos@1(comma_join_,0);
  197.   pos@2(comma_top_,0); y@0=y$; y@1=y$r; y@2=y@1+depth;
  198.   x@0l=x@1l=x$'l; lft x@2l=good.x(x$+eps);
  199.   filldraw stroke z@0e--z@1e..z@2e;  % tail
  200.  else: pos@1(vair,90); pos@2(vair,0); pos@3(vair,-45);
  201.   z@1l=z$l; lft x@2l=hround(x$-.5dot_size-jut)-2eps; x@3=x$+.5u;
  202.   y@2=1/3[y@1,y@3]; top y@3l=vround(y$+.5dot_size+depth);
  203.   y_:=ypart((z@1{left}...z@2{up}...z@3)
  204.    intersectiontimes (z$r{left}..{right}z$l)); if y_<0: y_:=1; fi
  205.   filldraw z$l{right}..subpath (0,y_) of (z$r{left}..{right}z$l)--cycle; % dot
  206.   filldraw stroke z@1e{left}...z@2e{up}...z@3e; fi  % tail
  207.  penlabels(@1,@2,@3); enddef;
  208.  
  209. %%% @ from to %%%% temporary formatting change
  210. vardef diag_in(suffix from,$)(expr sharpness)(suffix $$) =
  211.  pickup tiny.nib; save from_x,y_;
  212.  if y.from>y$: bot else: top fi\\ y_=y$;
  213.  (from_x,y_)=whatever[z.from,z$];
  214.  sharpness[z$,(from_x,y_)]{z$-z.from}
  215.   ...{z$$-z$}z$+sharpness*length(z$-(from_x,y_))*unitvector(z$$-z$) enddef;
  216.  
  217. vardef diag_out(suffix $)(expr sharpness)(suffix $$,to) =
  218.  pickup tiny.nib; save to_x,y_;
  219.  if y.to>y$: bot else: top fi\\ y_=y$;
  220.  (to_x,y_)=whatever[z$$,z.to];
  221.  z$$-sharpness*length(z$$-(to_x,y_))*unitvector(z$$-z$){z$$-z$}
  222.   ...{z.to-z$$}sharpness[z$$,(to_x,y_)] enddef;
  223.  
  224. vardef diag_end(suffix from,$)(expr sharpness_in,sharpness_out)(suffix $$,to)=
  225.  save from_x,to_x,y_,x_,xx_;
  226.  if y.from>y$: tiny.bot else: tiny.top fi\\ y_=y$; % we assume that |y$=y$$|
  227.  (from_x,y_)=whatever[z.from,z$]; (to_x,y_)=whatever[z$$,z.to];
  228.  if x$$>x$: x_=x$+sharpness_in*length(z$-(from_x,y_));
  229.   xx_=x$$-sharpness_out*length(z$$-(to_x,y_));
  230.   if xx_<x_: xx_:=x_:=.5[xx_,x_]; fi
  231.  else: x_=x$-sharpness_in*length(z$-(from_x,y_));
  232.   xx_=x$$+sharpness_out*length(z$$-(to_x,y_));
  233.   if xx_>x_: xx_:=x_:=.5[xx_,x_]; fi fi
  234.  sharpness_in[z$,(from_x,y_)]{z$-z.from}
  235.   ...{z$$-z$}(x_,y$)..(xx_,y$){z$$-z$}
  236.   ...{z.to-z$$}sharpness_out[z$$,(to_x,y_)] enddef;
  237. %%% at from to %%%% restore normal formatting
  238.  
  239. vardef special_diag_end(suffix $$,$,@,@@) = % for top middle of w's
  240.  if x@r<=x$r: diag_end($$r,$r,1,1,@l,@@l)
  241.  else: z0=whatever[z$$l,z$l]=whatever[z@l,z@@l];
  242.   diag_end($$r,$r,1,1,$l,0)--z0 fi enddef;
  243.  
  244. def prime_points_inside(suffix $,$$) =
  245.  theta_:=angle(z$r-z$l);
  246.  penpos$'(whatever,theta_);
  247.  if y$$>y$: z$'=(0,pen_top) rotated theta_ + whatever[z$l,z$r];
  248.   theta_:=angle(z$$-z$)-90;
  249.  else: z$'=(0,pen_bot) rotated theta_ + whatever[z$l,z$r];
  250.   theta_:=angle(z$$-z$)+90; fi
  251.  z$'l+(pen_lft,0) rotated theta_=z$l+whatever*(z$-z$$);
  252.  z$'r+(pen_rt,0) rotated theta_=z$r+whatever*(z$-z$$);
  253.  enddef;
  254.  
  255. def ellipse_set(suffix $,@,@@,$$) = % given |z$,x@,z$$|, find |y@| and |z@@|
  256. % such that the path |z${x@-x$,0}..z@{0,y@-y$}..{z$$-z@@}z@@|
  257. % is consistent with an ellipse
  258. % and such that the line |z@@--z$$| has a given |slope|
  259.  alpha_:=slope*(x@-x$); beta_:=y$$-y$-slope*(x$$-x$);
  260.  gamma_:=alpha_/beta_;
  261.  y@-y$=.5(beta_-alpha_*gamma_);
  262.  x@@-x$=-2gamma_*(x@-x$)/(1+gamma_*gamma_);
  263.  y@@-y$$=slope*(x@@-x$$) enddef;
  264.  
  265. vardef diag_ratio(expr a,b,y,c) = % assuming that $a>\vert b/y\vert$,
  266. % compute the value $\alpha=(x\6{++}y)/y$ such that $ax+b\alpha=c$
  267.  numeric a_,b_; b_=b/y; a_=a*a-b_*b_;
  268.  (a*(c++y*sqrt a_)-b_*c)/a_/y enddef;
  269.  
  270. def f_stroke(suffix $,$$,@,left_serif,right_serif)(expr left_jut,right_jut)=
  271.  pickup tiny.nib; bot y$=0;
  272.  penpos@0(x$r-x$l,0); x@0l=x$l; top y@0=x_height;
  273.  filldraw stroke z$e--z@0e;  % stem
  274.  pickup fine.nib; pos@0'(x$r-x$l-(hround stem_corr)+tiny,180);
  275.  y@0'=y@0; lft x@0'r=tiny.lft x$l;
  276.  penpos@1(x@0'l-x@0'r,180); x@1=x@0'; y@1+.5vair=.5[x_height,h];
  277.  pos@2(vair,90); top y@2r=h+oo;
  278.  if serifs: x@2=.6[x@1,x$$r]; (x@,y@2r)=whatever[z@2l,z@1l];
  279.   x@2r:=min(x@,.5[x@2,x$$r]); pos@3(hair,0); bulb(@2,@3,$$);  % bulb
  280.   filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2);  % arc
  281.   dish_serif($,@0,left_serif,1/3,left_jut,right_serif,1/3,right_jut); % serif
  282.  else: x@2=.6[x@1,x$$]; y@1l:=1/3[y@1l,y@2l];
  283.   filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2)
  284.    & term.e(@2,$$,right,.9,4); fi  % arc and terminal
  285.  penlabels(@0,@1,@2); enddef;
  286.  
  287. def h_stroke(suffix $,@,@@,$$) =
  288.  penpos$$(x@@r-x@@l,0); x$$=x@@; bot y$$=0;
  289.  y@@=1/3[bar_height,x_height];
  290.  penpos$''(x$r-x$l,0); x$''=x$; y$''=1/8[bar_height,x_height];
  291.  filldraw stroke z$''e--z$e;  % thicken the lower left stem
  292.  penpos@0(min(rt x$r-lft x$l,thin_join)-fine,180); pickup fine.nib;
  293.  rt x@0l=tiny.rt x$r; y@0=y$'';
  294.  pos@1(vair,90); pos@@'(x@@r-x@@l+tiny,0); z@@'=z@@;
  295.  x@1=.5[rt x@0l,rt x@@'r]; top y@1r=x_height+oo;
  296.  (x@,y@1l)=whatever[z@1r,z@0l]; x@1l:=x@;
  297.  filldraw stroke z@0e{up}...{right}z@1e
  298.   &{{interim superness:=hein_super; super_arc.e(@1,@@')}};  % arch
  299.  pickup tiny.nib; filldraw stroke z@@e--z$$e;  % right stem
  300.  labels(@0); penlabels(@1); enddef;
  301.  
  302. def hook_out(suffix $,$$,$$$)suffix modifier= % |x$| and |x$$$| (only) are known
  303.  pos$(stem,0); pos$$(vair,90);
  304.  x$$$:=hround(x$$$+.5hair-eps)-.5hair; pos$$$(hair,180);
  305.  y$=1/4x_height; bot y$$l=-oo; y$$$=1/3x_height;
  306.  if skewed.modifier: x$$=x$+1.25u;
  307.   filldraw stroke z$e{-u,-x_height}...z$$e{right}...{up}z$$$e;  % hook
  308.  else: x$$=x$+1.5u;
  309.   filldraw stroke z$e{down}...z$$e{right}
  310.    ...{x$$$-(x$+2.5u),x_height}z$$$e; fi enddef;  % hook
  311.  
  312. def empty_hook_out(suffix $,$$,$$$)suffix modifier= % |x$| and |x$$$| (only) are known
  313.  pos$(stem,0); pos$$(vair,90);
  314.  x$$$:=hround(x$$$+.5hair-eps)-.5hair; pos$$$(hair,180);
  315.  y$=1/4x_height; bot y$$l=-oo; y$$$=1/3x_height;
  316.  if skewed.modifier: x$$=x$+1.25u;
  317. %  filldraw stroke z$e{-u,-x_height}...z$$e{right}...{up}z$$$e;  % hook
  318.  else: x$$=x$+1.5u;
  319. %  filldraw stroke z$e{down}...z$$e{right}
  320. %   ...{x$$$-(x$+2.5u),x_height}z$$$e;
  321. fi enddef;  % empty_hook_out
  322.  
  323. def hook_in(suffix $,$$,$$$)suffix modifier= % |x$| and |x$$$| (only) are known
  324.  x$:=hround(x$-.5hair)+.5hair; pos$(hair,180);
  325.  pos$$(vair,90); pos$$$(stem,0);
  326.  y$=2/3x_height; top y$$r=x_height+oo; y$$$=3/4x_height;
  327.  if skewed.modifier: x$$=x$$$-1.25u;
  328.   filldraw stroke z$e{up}...z$$e{right}...{-u,-x_height}z$$$e;  % hook
  329.  else: x$$=x$$$-1.5u;
  330.   filldraw stroke z$e{x$$$-2.5u-x$,x_height}
  331.    ...z$$e{right}...{down}z$$$e; fi enddef;  % hook
  332.  
  333. def ital_arch(suffix $,$$,$$$) = % |z$| and |z$$$| (only) are known
  334.  pos$'(hair,180); z$'=z$;
  335.  pos$$(vair,90); pos$$$(stem,0);
  336.  {{interim superness := more_super; x$$=.6[x$,x$$$];
  337.  top y$$r=x_height+oo; y$$$=.65x_height;
  338.  filldraw stroke z$'e{up}...super_arc.e($$,$$$);}} enddef;  % stroke
  339.  
  340. def compute_spread(expr normal_spread,big_spread)=
  341.  spread#:=math_spread[normal_spread,big_spread];
  342.  spread:=ceiling(spread#*hppp)+eps; enddef;
  343.  
  344. def v_center(expr h_sharp) =
  345.  .5h_sharp+math_axis#, .5h_sharp-math_axis# enddef;
  346.  
  347. def circle_points =
  348.  x4=x8=.5[x2,x6]; x1=x3=superness[x4,x2]; x5=x7=superness[x4,x6];
  349.  y2=y6=.5[y4,y8]; y1=y7=superness[y2,y8]; y3=y5=superness[y2,y4];
  350.  enddef;
  351. def draw_circle =
  352.  draw z8{right}...z1{z2-z8}...z2{down}...z3{z4-z2}...z4{left}
  353.   ...z5{z6-z4}...z6{up}...z7{z8-z6}...cycle enddef;
  354.  
  355. def left_paren(expr min_breadth, max_breadth) =
  356.  pickup fine.nib; pos1(hround min_breadth,0);
  357.  pos2(hround max_breadth,0); pos3(hround min_breadth,0);
  358.  rt x1r=rt x3r=hround(w-1.25u+.5min_breadth); lft x2l=hround 1.25u;
  359.  top y1=h; y2=.5[y1,y3]; bot y3=1-d;
  360.  filldraw stroke z1e{3(x2e-x1e),y2-y1}...z2e
  361.   ...{3(x3e-x2e),y3-y2}z3e;  % arc
  362.  penlabels(1,2,3); enddef;
  363.  
  364. def right_paren(expr min_breadth, max_breadth) =
  365.  pickup fine.nib; pos1(hround min_breadth,0);
  366.  pos2(hround max_breadth,0); pos3(hround min_breadth,0);
  367.  lft x1l=lft x3l=hround(1.25u-.5min_breadth); rt x2r=hround(w-1.25u);
  368.  top y1=h; y2=.5[y1,y3]; bot y3=1-d;
  369.  filldraw stroke z1e{3(x2e-x1e),y2-y1}...z2e
  370.   ...{3(x3e-x2e),y3-y2}z3e;  % arc
  371.  penlabels(1,2,3); enddef;
  372.  
  373. def left_bracket(expr breadth,do_top,do_bot) =
  374.  pickup crisp.nib;
  375.  numeric thickness; thickness=hround breadth;
  376.  pos1(thickness,0); pos2(thickness,0);
  377.  top y1=h; bot y2=1-d; lft x1l=lft x2l=hround(2.5u-.5thickness);
  378.  filldraw stroke z1e--z2e;  % stem
  379.  pos3(thickness,90); pos4(thickness,90);
  380.  pos5(thickness,90); pos6(thickness,90);
  381.  x3=x5=x1l; rt x4=rt x6=hround(w-.75u+.5thickness);
  382.  y3r=y4r=y1; y5l=y6l=y2;
  383.  if do_top: filldraw stroke z3e--z4e; fi  % upper bar
  384.  if do_bot: filldraw stroke z5e--z6e; fi  % lower bar
  385.  penlabels(1,2,3,4,5,6); enddef;
  386.  
  387. def right_bracket(expr breadth,do_top,do_bot) =
  388.  pickup crisp.nib;
  389.  numeric thickness; thickness=hround breadth;
  390.  pos1(thickness,0); pos2(thickness,0);
  391.  top y1=h; bot y2=1-d; rt x1r=rt x2r=hround(w-2.5u+.5thickness);
  392.  filldraw stroke z1e--z2e;  % stem
  393.  pos3(thickness,90); pos4(thickness,90);
  394.  pos5(thickness,90); pos6(thickness,90);
  395.  x3=x5=x1r; lft x4=lft x6=hround(.75u-.5thickness);
  396.  y3r=y4r=y1; y5l=y6l=y2;
  397.  if do_top: filldraw stroke z3e--z4e; fi  % upper bar
  398.  if do_bot: filldraw stroke z5e--z6e; fi  % lower bar
  399.  penlabels(1,2,3,4,5,6); enddef;
  400.  
  401. def left_curly(expr min_breadth, max_breadth) =
  402.  pickup fine.nib;
  403.  forsuffixes $=1,1',4,4',7,7': pos$(hround min_breadth,0); endfor
  404.  forsuffixes $=2,3,5,6: pos$(hround max_breadth,0); endfor
  405.  x2=x3=x5=x6; x1=x1'=x7=x7'=w-x4=w-x4';
  406.  lft x4l=hround(1.5u-.5min_breadth); lft x2l=hround(.5w-.5max_breadth);
  407.  top y1=h; bot y7=1-d; .5[y4,y4']=.5[y1,y7]=.5[y2,y6]=.5[y3,y5];
  408.  y1-y2=y3-y4=(y1-y4)/4;
  409.  y1-y1'=y4-y4'=y7'-y7=vround(min_breadth-fine);
  410.  filldraw z1l{3(x2l-x1l),y2-y1}...z2l---z3l...{3(x4l-x3l),y4-y3}z4l
  411.   --z4'l{3(x5l-x4l),y5-y4'}...z5l---z6l...{3(x7l-x6l),y7-y6}z7l
  412.   --z7r--z7'r{3(x6r-x7r),y6-y7'}...z6r---z5r
  413.   ...{3(x4r-x5r),.5[y4,y4']-y5}.5[z4r,z4'r]{3(x3r-x4r),y3-.5[y4,y4']}
  414.   ...z3r---z2r...{3(x1r-x2r),y1'-y2}z1'r--z1r--cycle;  % stroke
  415.  penlabels(1,2,3,4,5,6,7); enddef;
  416.  
  417. def right_curly(expr min_breadth, max_breadth) =
  418.  pickup fine.nib;
  419.  forsuffixes $=1,1',4,4',7,7': pos$(hround min_breadth,0); endfor
  420.  forsuffixes $=2,3,5,6: pos$(hround max_breadth,0); endfor
  421.  x2=x3=x5=x6; x1=x1'=x7=x7'=w-x4=w-x4';
  422.  lft x1l=hround(1.5u-.5min_breadth); lft x2l=hround(.5w-.5max_breadth);
  423.  top y1=h; bot y7=1-d; .5[y4,y4']=.5[y1,y7]=.5[y2,y6]=.5[y3,y5];
  424.  y1-y2=y3-y4=(y1-y4)/4;
  425.  y1-y1'=y4-y4'=y7'-y7=vround(min_breadth-fine);
  426.  filldraw z1r{3(x2r-x1r),y2-y1}...z2r---z3r...{3(x4r-x3r),y4-y3}z4r
  427.   --z4'r{3(x5r-x4r),y5-y4'}...z5r---z6r...{3(x7r-x6r),y7-y6}z7r
  428.   --z7l--z7'l{3(x6l-x7l),y6-y7'}...z6l---z5l
  429.   ...{3(x4l-x5l),.5[y4,y4']-y5}.5[z4l,z4'l]{3(x3l-x4l),y3-.5[y4,y4']}
  430.   ...z3l---z2l...{3(x1l-x2l),y1'-y2}z1'l--z1l--cycle;  % stroke
  431.  penlabels(1,2,3,4,5,6,7); enddef;
  432.  
  433. def left_angle(expr breadth) =
  434.  pickup pencircle scaled breadth;
  435.  x1=x3=good.x(w-u)+eps; lft x2=hround u-eps;
  436.  top y1=h+eps; .5[y1,y3]=y2=good.y .5[-d+eps,h];
  437.  draw z1--z2--z3;  % diagonals
  438.  labels(1,2,3); enddef;
  439.  
  440. def right_angle(expr breadth) =
  441.  pickup pencircle scaled breadth;
  442.  x1=x3=good.x u-eps; rt x2=hround(w-u)+eps;
  443.  top y1=h+eps; .5[y1,y3]=y2=good.y .5[-d+eps,h];
  444.  draw z1--z2--z3;  % diagonals
  445.  labels(1,2,3); enddef;
  446.  
  447. def big_slash(expr breadth) =
  448.  adjust_fit(-letter_fit#,-letter_fit#); pickup pencircle scaled breadth;
  449.  rt x1=hround(w-u); lft x2=hround u; top y1=h+eps; bot y2=1-d-eps;
  450.  draw z1--z2;  % diagonal
  451.  labels(1,2); enddef;
  452.  
  453. def big_blash(expr breadth) =
  454.  adjust_fit(-letter_fit#,-letter_fit#); pickup pencircle scaled breadth;
  455.  lft x1=hround u; rt x2=hround(w-u); top y1=h+eps; bot y2=1-d-eps;
  456.  draw z1--z2;  % diagonal
  457.  labels(1,2); enddef;
  458.  
  459. def big_sqrt =
  460.  adjust_fit(0,-letter_fit#); pickup rule.nib;
  461.  x1=good.x 4/9w; x2=good.x(w+.5); bot y1=-d; bot y2=0;
  462.  draw z1--z2;  % diagonal
  463.  pickup crisp.nib; pos3(max(curve,rule_thickness),0);
  464.  x3l=1.5[x2,x1]; y3=.5[y1,y2];
  465.  pos4(rule_thickness,0); x4=x1; bot y4=-d;
  466.  pos5(vair,-45); x5l=good.x(x3l-u); z5l=whatever[z3r,z2];
  467.  z6=z5r+whatever*(z2-z3r)=whatever[z3l,z4l];
  468.  z7=whatever[z1,z2]=z3r+whatever*(z4l-z3l);
  469.  filldraw z5r--z6--z4l--z4--z7--z3r--z5l--cycle;  % left diagonal and serif
  470.  penlabels(1,2,3,4,5,6,7); enddef;
  471.  
  472. def big_hat =
  473.  adjust_fit(0,0);
  474.  pickup crisp.nib; pos2(.6[vair,curve],90); top y2r=h+o; x2=.5w;
  475.  x1=w-x3=good.x -eps; y1=y3=.5[x_height,y2];
  476.  pos1(hair,angle(z2-z1)+90); pos3(hair,angle(z3-z2)+90);
  477.  filldraw stroke z1e--z2e--z3e;  % diagonals
  478.  penlabels(1,2,3); enddef;
  479.  
  480. def big_tilde =
  481.  adjust_fit(0,0); pickup crisp.nib;
  482.  numeric theta; theta=angle(1/6(w-vair),1/4(h-x_height));
  483.  numeric mid_width; mid_width=.4[vair,stem];
  484.  pos1(vair,theta+90); pos2(vair,theta+90);
  485.  pos3(vair,theta+90); pos4(vair,theta+90);
  486.  z2-z1=z4-z3=(mid_width-crisp)*dir theta;
  487.  lft x1r=w-rt x4l=0; top y4r=h;
  488.  bot y1l=vround(bot y1l+min(2/3[x_height,h],y3l-.25vair)-top y1r);
  489.  pair delta; ypart delta=3(y3l-y1l); delta=whatever*dir theta;
  490.  filldraw z1l..controls(z1l+delta)and(z3l-delta)..z3l..z4l
  491.   --z4r..controls(z4r-delta)and(z2r+delta)..z2r..z1r--cycle;  % stroke
  492.  penlabels(1,2,3,4); enddef;
  493.  
  494. def beginarithchar(expr c) = % ensure consistent dimensions for $+$, $-$, etc.
  495.  if monospace: beginchar(c,14u#,27/7u#+math_axis#,27/7u#-math_axis#);
  496.  else: beginchar(c,14u#,6u#+math_axis#,6u#-math_axis#); fi
  497.  italcorr math_axis#*slant-.5u#;
  498.  adjust_fit(0,0); enddef;
  499.  
  500. newinternal l,r,shrink_fit; % adjustments to spacing
  501.  
  502. def normal_adjust_fit(expr left_adjustment,right_adjustment) =
  503.  numeric expansion_factor;
  504.  mono_charwd#=2letter_fit#
  505.    +expansion_factor*(charwd+left_adjustment+right_adjustment);
  506.   l:=-hround(left_adjustment*hppp)-letter_fit;
  507.  interim xoffset:=-l;
  508.  charwd:=charwd+2letter_fit#+left_adjustment+right_adjustment;
  509.  r:=l+hround(charwd*hppp)-shrink_fit;
  510.  w:=r-hround(right_adjustment*hppp)-letter_fit;
  511.  if monospace:
  512.  forsuffixes $=u,uu,jut,cap_jut,beak_jut,apex_corr:
  513.    $:=$.#*hppp; endfor
  514.  fi
  515.  enddef;
  516.  
  517. def mono_adjust_fit(expr left_adjustment,right_adjustment) =
  518.  numeric expansion_factor;
  519.  mono_charwd#=2letter_fit#
  520.    +expansion_factor*(charwd+left_adjustment+right_adjustment);
  521.  forsuffixes $=u,uu,jut,cap_jut,beak_jut,apex_corr:
  522.    $:=$.#*expansion_factor*hppp; endfor
  523.  l:=-hround(left_adjustment*expansion_factor*hppp)-letter_fit;
  524.  interim xoffset:=-l;
  525.  r:=l+mono_charwd-shrink_fit;
  526.  w:=r-hround(right_adjustment*expansion_factor*hppp)-letter_fit;
  527.  charwd:=mono_charwd#; charic:=mono_charic#;
  528.  enddef;
  529.  
  530. extra_endchar:=extra_endchar&"r:=r+shrink_fit;w:=r-l;";
  531.  
  532. def ignore_math_fit(expr left_adjustment,right_adjustment) = enddef;
  533. def do_math_fit(expr left_adjustment,right_adjustment) =
  534.  l:=l-hround(left_adjustment*hppp); interim xoffset:=-l;
  535.  charwd:=charwd+left_adjustment+right_adjustment;
  536.  r:=l+hround(charwd*hppp)-shrink_fit;
  537.  charic:=charic-right_adjustment;
  538.  if charic<0: charic:=0; fi enddef;
  539. def zero_width = charwd:=0; r:=l-shrink_fit enddef;
  540. def change_width = if not monospace: % change width by $\pm1$
  541.  if r+shrink_fit-l=floor(charwd*hppp): w:=w+1; r:=r+1;
  542.  else: w:=w-1; r:=r-1; fi fi enddef;
  543. def padded expr del_sharp =
  544.  charht:=charht+del_sharp; chardp:=chardp+del_sharp enddef;
  545.  
  546. def font_setup =
  547.  if monospace: let adjust_fit=mono_adjust_fit;
  548.   def mfudged=fudged enddef;
  549.   mono_charic#:=body_height#*slant;
  550.   if mono_charic#<0: mono_charic#:=0; fi
  551.   mono_charwd#:=9u#; define_whole_pixels(mono_charwd);
  552.  else: let adjust_fit=normal_adjust_fit;
  553.   def mfudged= enddef; fi
  554.  if math_fitting: let math_fit=do_math_fit
  555.  else: let math_fit=ignore_math_fit fi;
  556.  define_pixels(u,uu,width_adj,serif_fit,cap_serif_fit,jut,cap_jut,beak,
  557.   bar_height,dish,bracket,beak_jut,stem_corr,vair_corr,apex_corr);
  558.  define_blacker_pixels(notch_cut,cap_notch_cut);
  559.  define_whole_pixels(letter_fit,fine,crisp,tiny);
  560.  define_whole_vertical_pixels(body_height,asc_height,
  561.   cap_height,acc_height,fig_height,x_height,comma_depth,desc_depth,serif_drop);
  562.  define_whole_blacker_pixels(thin_join,hair,stem,curve,flare,
  563.   dot_size,cap_hair,cap_stem,cap_curve);
  564.  define_whole_vertical_blacker_pixels(vair,bar,slab,cap_bar,cap_band);
  565.  define_corrected_pixels(o,apex_o);
  566.  forsuffixes $=hair,stem,cap_stem:
  567.   fudged$.#:=fudge*$.#; fudged$:=hround(fudged$.#*hppp+blacker);
  568.   forever: exitif fudged$>.9fudge*$; fudged$:=fudged$+1; endfor endfor
  569.  rule_thickness:=ceiling(rule_thickness#*hppp);
  570.  heavy_rule_thickness:=ceiling(3rule_thickness#*hppp);
  571.  oo:=vround(.5o#*hppp*o_correction)+eps;
  572.  apex_oo:=vround(.5apex_o#*hppp*o_correction)+eps;
  573.  lowres_fix(stem,curve,flare) 1.3;
  574.  lowres_fix(stem,curve) 1.2;
  575.  lowres_fix(cap_stem,cap_curve) 1.2;
  576.  lowres_fix(hair,cap_hair) 1.2;
  577.  lowres_fix(cap_band,cap_bar,bar,slab) 1.2;
  578.  stem':=hround(stem-stem_corr); cap_stem':=hround(cap_stem-stem_corr);
  579.  vair':=vround(vair+vair_corr);
  580.  vstem:=vround .8[vair,stem]; cap_vstem:=vround .8[vair,cap_stem];
  581.  ess:=(ess#/stem#)*stem; cap_ess:=(cap_ess#/cap_stem#)*cap_stem;
  582.  dw:=(curve#-stem#)*hppp; bold:=curve#*hppp+blacker;
  583.  dh#:=.6designsize;
  584.  stem_shift#:=if serifs: 2stem_corr# else: 0 fi;
  585.  more_super:=max(superness,sqrt .77superness);
  586.  hein_super:=max(superness,sqrt .81225258superness); % that's $2^{-.3}$
  587.  clear_pen_memory;
  588.  if fine=0: fine:=1; fi
  589.  forsuffixes $=fine,crisp,tiny:
  590. %%% fine $ %%%% temporary formatting convention for MFT
  591.   if $>fudged.hair: $:=fudged.hair; fi
  592.   $.breadth:=$;
  593.   pickup if $=0: nullpen else: pencircle scaled $; $:=$-eps fi;
  594.   $.nib:=savepen; breadth_[$.nib]:=$;
  595.   forsuffixes $$=lft,rt,top,bot: shiftdef($.$$,$$ 0); endfor endfor
  596. %%% @ $ %%%% restore ordinary formatting for $
  597.  min_Vround:=max(fine.breadth,crisp.breadth,tiny.breadth);
  598.  if min_Vround<vround min_Vround: min_Vround:=vround min_Vround; fi
  599.  if flare<vround flare: flare:=vround flare; fi
  600.  forsuffixes $=vair,bar,slab,cap_bar,cap_band,vair',vstem,cap_vstem,bold:
  601.   if $<min_Vround: $:=min_Vround; fi endfor
  602.  pickup pencircle scaled min(hair,vair); extra_rule.nib :=savepen;
  603.  pickup pencircle scaled rule_thickness; rule.nib:=savepen;
  604.  math_axis:=good.y(math_axis#*hppp);
  605.  pickup pencircle scaled if hefty:(.6[vair,fudged.hair]) else:fudged.hair fi;
  606.  light_rule.nib:=savepen;
  607.  pickup pencircle xscaled cap_curve yscaled cap_hair rotated 30;
  608.  cal.nib:=savepen;
  609.  pair cal.extension; cal.extension:=(.75cap_curve,0) rotated 30;
  610.  pickup pencircle xscaled cap_curve yscaled cap_hair rotated 70;
  611.  tilted.nib:=savepen;
  612.  pickup pencircle xscaled curve yscaled cap_hair rotated 70;
  613.  med_tilted.nib:=savepen;
  614.  pickup pencircle xscaled cap_stem yscaled cap_hair rotated 30;
  615.  med_cal.nib:=savepen;
  616.  pickup pencircle xscaled stem yscaled cap_hair rotated 30;
  617.  light_cal.nib:=savepen;
  618.  pickup pencircle xscaled(cap_curve+dw) yscaled cap_hair rotated 30;
  619.  heavy_cal.nib:=savepen;
  620.  bot_flourish_line:=-.5u-o;
  621.  pair bend; bend=(.5u,0);
  622.  pair flourish_change; flourish_change=(4u,.2asc_height);
  623.  join_radius:=u;
  624.  currenttransform:=identity slanted slant
  625.   yscaled aspect_ratio scaled granularity;
  626.  if currenttransform=identity: let t_=relax
  627.  else: def t_ = transformed currenttransform enddef fi;
  628.  numeric paren_depth#; .5[body_height#,-paren_depth#]=math_axis#;
  629.  numeric asc_depth#; .5[asc_height#,-asc_depth#]=math_axis#;
  630.  body_depth:=desc_depth+body_height-asc_height;
  631.  shrink_fit:=1+hround(2letter_fit#*hppp)-2letter_fit;
  632.  if not string mode: if mode<=smoke: shrink_fit:=0; fi fi
  633.  enddef;
  634.  
  635. def shiftdef(suffix $)(expr delta) =
  636.  vardef $ primary x = x+delta enddef enddef;
  637.  
  638. def makebox(text rule) =
  639.  for y=0,(cap_height+acc_height),
  640.        asc_height,body_height,x_height,bar_height,-desc_depth,-body_depth:
  641.   rule((l,y)t_,(r,y)t_); endfor % horizontals
  642.  
  643.  for y=-3.5pt,8.5pt,(x_height+acc_height):
  644.    rule((l-4pt,y)t_,(l-2pt,y)t_); endfor
  645.  for x=l,r:   rule((x,-body_depth)t_,(x,body_height)t_); endfor % verticals
  646.  for x=u*(1+floor(l/u)) step u until r-1:
  647.   rule((x,-body_depth)t_,(x,body_height)t_); endfor % more verticals
  648.  
  649.  for x=0.5w:
  650.    rule((x,-body_depth-1pt)t_,(x,-body_depth-1.5pt)t_);
  651.    rule((x,cap_height+acc_height+1pt)t_,(x,cap_height+acc_height+1.5pt)t_);
  652.  endfor
  653.  if charic<>0:
  654.   rule((r+charic*pt,h.o_),(r+charic*pt,.5h.o_)); fi % italic correction
  655.  enddef;
  656. def maketicks(text rule) =
  657.  for y=0,h.o_,-d.o_:
  658.   rule((l,y),(l+10,y)); rule((r-10,y),(r,y)); endfor % horizontals
  659.  for x=l,r:
  660.   rule((x,10-d.o_),(x,-d.o_)); rule((x,h.o_-10),(x,h.o_)); endfor % verticals
  661.  if charic<>0:
  662.   rule((r+charic*pt,h.o_-10),(r+charic*pt,h.o_)); fi % italic correction
  663.  enddef;
  664. rulepen:=pensquare;
  665.  
  666. vardef stroke text t =
  667.  forsuffixes e = l,r: path_.e:=t; endfor
  668.  if cycle path_.l:
  669.   errmessage "Beware: `stroke' isn't intended for cycles"; fi
  670.  path_.l -- reverse path_.r -- cycle enddef;
  671.  
  672. vardef circ_stroke text t =
  673.  forsuffixes e = l,r: path_.e:=t; endfor
  674.  if cycle path_.l:
  675.   errmessage "Beware: `stroke' isn't intended for cycles"; fi
  676.  path_.l -- reverse path_.r .. cycle enddef;
  677.  
  678. vardef super_arc.r(suffix $,$$) = % outside of super-ellipse
  679.  pair center,corner;
  680.  if y$=y$r: center=(x$$r,y$r); corner=(x$r,y$$r);
  681.  else: center=(x$r,y$$r); corner=(x$$r,y$r); fi
  682.  z$.r{corner-z$.r}...superness[center,corner]{z$$.r-z$.r}
  683.   ...{z$$.r-corner}z$$.r enddef;
  684.  
  685. vardef super_arc.l(suffix $,$$) = % inside of super-ellipse
  686.  pair center,corner;
  687.  if y$=y$r: center=(x$$l,y$l); corner=(x$l,y$$l);
  688.  else: center=(x$l,y$$l); corner=(x$$l,y$l); fi
  689.  z$l{corner-z$l}...superness[center,corner]{z$$l-z$l}
  690.   ...{z$$l-corner}z$$l enddef;
  691.  
  692. vardef pulled_super_arc.r(suffix $,$$)(expr superpull) =
  693.  pair center,corner;
  694.  if y$=y$r: center=(x$$r,y$r); corner=(x$r,y$$r);
  695.  else: center=(x$r,y$$r); corner=(x$$r,y$r); fi
  696.  z$r{corner-z$r}...superness[center,corner]{z$$r-z$r}
  697.   ...{z$$r-corner}z$$r enddef;
  698.  
  699. vardef pulled_super_arc.l(suffix $,$$)(expr superpull) =
  700.  pair center,corner,outer_point;
  701.  if y$=y$r: center=(x$$l,y$l); corner=(x$l,y$$l);
  702.   outer_point=superness[(x$$r,y$r),(x$r,y$$r)];
  703.  else: center=(x$l,y$$l); corner=(x$$l,y$l);
  704.   outer_point=superness[(x$r,y$$r),(x$$r,y$r)]; fi
  705.  z$l{corner-z$l}
  706.   ...superpull[superness[center,corner],outer_point]{z$$l-z$l}
  707.   ...{z$$l-corner}z$$l enddef;
  708.  
  709. vardef pulled_arc@#(suffix $,$$) =
  710.  pulled_super_arc@#($,$$)(superpull) enddef;
  711.  
  712. vardef serif_arc(suffix $,$$) =
  713.  z${x$$-x$,0}...(.75[x$,x$$],.25[y$,y$$]){z$$-z$}...{0,y$$-y$}z$$ enddef;
  714.  
  715. vardef penpos@#(expr b,d) =
  716.  if known b: if b<=0:
  717.    errmessage "bad penpos (width is negative)"; fi fi
  718.  (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d;
  719.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  720.  
  721. newinternal currentbreadth;
  722. vardef pos@#(expr b,d) =
  723.  if known b: if b<=currentbreadth:
  724.  errmessage "bad pos (breadth of current pen wider than pos width)"; fi fi
  725.  (x@#r-x@#l,y@#r-y@#l)=(b-currentbreadth,0) rotated d;
  726.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  727. def numeric_pickup_ primary q =
  728.  currentpen:=pen_[q];
  729.  pen_lft:=pen_lft_[q];  pen_rt:=pen_rt_[q];
  730.  pen_top:=pen_top_[q];  pen_bot:=pen_bot_[q];
  731.  currentpen_path:=pen_path_[q];
  732.  if known breadth_[q]: currentbreadth:=breadth_[q]; fi enddef;
  733.  
  734. vardef ic# = charic enddef;
  735. vardef h# = charht enddef;
  736. vardef w# = charwd enddef;
  737. vardef d# = chardp enddef;
  738.  
  739. let {{=begingroup; let }}=endgroup;
  740. def .... = .. tension atleast .9 .. enddef;
  741. def less_tense = save ...; let ...=.... enddef;
  742. def ?? = hide(showvariable x,y) enddef;
  743.  
  744. let semi_ =;; let colon_ = :; let endchar_ = endchar;
  745. def iff expr b = if b:let next_=use_it else:let next_=lose_it fi; next_ enddef;
  746. def use_it = let : = restore_colon; enddef;
  747. def restore_colon = let : = colon_; enddef;
  748. def lose_it = let endchar=fi; inner dcchar; let ;=fix_ semi_ if false enddef;
  749. def fix_=let ;=semi_; let endchar=endchar_; outer dcchar; enddef;
  750. def always_iff = let : = endgroup; killboolean enddef;
  751. def killboolean text t = use_it enddef;
  752. outer dcchar;
  753.  
  754. %
  755. %  special routines for accenting
  756. %
  757. vardef uppercase_hat
  758.     (expr x_center,y_move,hat_zero,hat_one,hat_two,hat_three,hat_four) =
  759. h':=min(asc_height,2x_height);
  760. if serifs:
  761.  pickup crisp.nib;
  762.  pos[hat_two](.5[vair,curve],90);
  763.  top y[hat_two]r=h+y_move;
  764.  x[hat_two]=good.x x_center; %  optically centered
  765.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi ;
  766.  x[hat_three]=2x[hat_two]-x[hat_one];
  767.  y[hat_one]=y[hat_three] =
  768.      max(y[hat_two]-0.5(min(asc_height,2x_height)-x_height),
  769.          1/6[cap_height,h]);
  770.  pos[hat_one](hair,angle(z[hat_two]-z[hat_one])+90);
  771.  pos[hat_three](hair,angle(z[hat_three]-z[hat_two])+90);
  772.  filldraw stroke z[hat_one]e--z[hat_two]e--z[hat_three]e;  % diagonals
  773. else:
  774.  pickup fine.nib;
  775.  pos[hat_one](vair,0);
  776.  pos[hat_three](vair,0);
  777.  pos[hat_two](stem,0);
  778.  top y[hat_two]=h+y_move;
  779.  x[hat_two]=good.x x_center; %  optically centered
  780.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi ;
  781.  x[hat_three]=2x[hat_two]-x[hat_one];
  782.  bot y[hat_one]=bot y[hat_three] =
  783.     vround (h-(h'-2/3[h',x_height])-eps);
  784.      % same slope as in the acute accent
  785.  z[hat_zero]=whatever[z[hat_one]r,z[hat_two]r]=
  786.     whatever[z[hat_two]l,z[hat_three]l];
  787.  y[hat_four]l=y[hat_four]r=y[hat_two];
  788.  x[hat_four]l=good.x .2[x[hat_two]l,x[hat_two]];
  789.  x[hat_four]r=w-x[hat_four]l;
  790.  filldraw z[hat_four]l--z[hat_one]l--z[hat_one]r--
  791.     z[hat_zero]--z[hat_three]l--
  792.     z[hat_three]r--z[hat_four]r--cycle; fi  % diagonals
  793. enddef;
  794. %
  795. vardef lowercase_hat
  796.     (expr x_center,y_move,hat_zero,hat_one,hat_two,hat_three,hat_four) =
  797. if serifs:
  798.  pickup crisp.nib;
  799.  pos[hat_two](.5[vair,curve],90);
  800.  top y[hat_two]r=h+y_move;
  801.  x[hat_two]=good.x x_center; %  optically centered
  802.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi ;
  803.  x[hat_three]=2x[hat_two]-x[hat_one];
  804.  y[hat_one]=y[hat_three] =
  805.      max(y[hat_two]-0.5(min(asc_height,2x_height)-x_height),
  806.          1/6[x_height,h]);
  807.  pos[hat_one](hair,angle(z[hat_two]-z[hat_one])+90);
  808.  pos[hat_three](hair,angle(z[hat_three]-z[hat_two])+90);
  809.  filldraw stroke z[hat_one]e--z[hat_two]e--z[hat_three]e;  % diagonals
  810. else:
  811.  pickup fine.nib;
  812.  pos[hat_one](vair,0);
  813.  pos[hat_three](vair,0);
  814.  pos[hat_two](stem,0);
  815.  top y[hat_two]=h+y_move;
  816.  x[hat_two]=good.x x_center; %  optically centered
  817.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi ;
  818.  x[hat_three]=2x[hat_two]-x[hat_one];
  819.  bot y[hat_one]=bot y[hat_three]=vround (2/3[h,x_height]-eps);
  820.      % same slope as in the acute accent
  821.  z[hat_zero]=whatever[z[hat_one]r,z[hat_two]r]=
  822.     whatever[z[hat_two]l,z[hat_three]l];
  823.  y[hat_four]l=y[hat_four]r=y[hat_two];
  824.  x[hat_four]l=good.x .2[x[hat_two]l,x[hat_two]];
  825.  x[hat_four]r=w-x[hat_four]l;
  826.  filldraw z[hat_four]l--z[hat_one]l--z[hat_one]r--
  827.     z[hat_zero]--z[hat_three]l--
  828.     z[hat_three]r--z[hat_four]r--cycle; fi  % diagonals
  829. enddef;
  830. %
  831. %
  832. vardef lowercase_gravis
  833.    (expr x_move,y_move,grave_one,grave_two) =
  834. if serifs: pickup crisp.nib;
  835.  x[grave_one]-.5stem=hround(x_move+.5w-2.5u if monospace:/expansion_factor fi);
  836.  x[grave_two]=hround(x_move+.5w+0.5u if monospace:/expansion_factor fi);
  837.  y[grave_one]+.5stem=h+eps+y_move;
  838.  y[grave_one]-y[grave_two]=acc_height+eps-0.5stem-max(.27acc_height,o+hair);
  839.  numeric theta; theta=angle(z[grave_two]-z[grave_one])+90;
  840.  pos[grave_one](stem,theta);
  841.  pos[grave_two](hair,theta);
  842.  filldraw circ_stroke z[grave_one]e--z[grave_two]e;  % diagonal
  843. else: pickup fine.nib;
  844.  pos[grave_one](stem,0);
  845.  pos[grave_two](vair,0);
  846.  lft x[grave_one]l=hround(x_move+.5w-3u if monospace: /expansion_factor fi);
  847.  rt x[grave_two]r=hround(x_move+.5w
  848.       +0.25u if monospace: /expansion_factor fi+0.5vair);
  849.  top y[grave_one]=h+y_move;
  850.  bot y[grave_two]=vround (y_move+h-.68acc_height);
  851.  filldraw stroke z[grave_one]e--z[grave_two]e; fi  % diagonal
  852. enddef;
  853. %
  854. def uppercase_gravis = lowercase_gravis enddef;
  855. %
  856. %
  857. vardef lowercase_acute
  858.    (expr x_move,y_move,acute_one,acute_two) =
  859. if serifs: pickup crisp.nib;
  860.  x[acute_one]+.5stem=hround(x_move+.5w+2.5u if monospace: /expansion_factor fi);
  861.  x[acute_two]=hround(x_move+.5w-0.5u if monospace: /expansion_factor fi);
  862.  y[acute_one]=y_move+h+eps-0.5stem;
  863.  y[acute_one]-y[acute_two]=acc_height+eps-0.5stem-max(.27acc_height,o+hair);
  864.  numeric theta; theta=angle(z[acute_two]-z[acute_one])+90;
  865.  pos[acute_one](stem,theta);
  866.  pos[acute_two](hair,theta);
  867.  filldraw circ_stroke z[acute_one]e--z[acute_two]e;  % diagonal
  868. else: pickup fine.nib;
  869.  pos[acute_one](stem,0);
  870.  pos[acute_two](vair,0);
  871.  rt x[acute_one]r=hround(x_move+.5w+3u if monospace: /expansion_factor fi);
  872.  lft x[acute_two]l=hround(x_move+.5w
  873.     -0.25u if monospace: /expansion_factor fi-0.5vair);
  874.  top y[acute_one]=h+y_move;
  875.  bot y[acute_two]=vround (y_move+h-.68acc_height);
  876.  filldraw stroke z[acute_one]e--z[acute_two]e; fi  % diagonal
  877. enddef;
  878. %
  879. def uppercase_acute = lowercase_acute enddef;
  880. %
  881. %
  882. vardef lowercase_tilde(expr x_move,y_move,tilde_one,tilde_two,tilde_three,
  883.      tilde_four,tilde_five)=
  884. h':=min(asc_height,10/7x_height+.5dot_size);
  885. if serifs: numeric theta;
  886.  theta=angle(1/6(
  887.     6u if monospace: /expansion_factor fi-vair),
  888.       1/4(h'-x_height));
  889.  pickup crisp.nib;
  890.  numeric mid_width; mid_width=.4[vair,stem];
  891.  pos[tilde_one](vair,theta+90);
  892.  pos[tilde_two](vair,theta+90);
  893.  pos[tilde_three](vair,theta+90);
  894.  pos[tilde_four](vair,theta+90);
  895.  z[tilde_two]-z[tilde_one]=
  896.     z[tilde_four]-z[tilde_three]=(mid_width-crisp)*dir theta;
  897.  lft x[tilde_one]r=hround(x_move+0.5w-3u if monospace: /expansion_factor fi);
  898.  rt x[tilde_four]l=hround(x_move+0.5w+3u if monospace: /expansion_factor fi);
  899.  top y[tilde_four]r=h';
  900.  bot y[tilde_one]l=vround(bot y[tilde_one]l+
  901.     min(2/3[x_height,h'],y[tilde_three]l-.25vair)-top y[tilde_one]r);
  902.  pair delta;
  903.  ypart delta=3(y[tilde_three]l-y[tilde_one]l);
  904.  delta=whatever*dir theta;
  905.  filldraw z[tilde_one]l..
  906.    controls(z[tilde_one]l+
  907.     delta)and(z[tilde_three]l-delta)..z[tilde_three]l..z[tilde_four]l
  908.   --z[tilde_four]r..
  909.      controls(z[tilde_four]r-delta)and(z[tilde_two]r+delta)..
  910.      z[tilde_two]r..z[tilde_one]r--cycle;  % stroke
  911. else:
  912.  pickup fine.nib;
  913.  pos[tilde_one](vair,180);
  914.  pos[tilde_two](vair,90);
  915.  pos[tilde_three](.5[vair,slab],90);
  916.  pos[tilde_four](vair,90);
  917.  pos[tilde_five](vair,180);
  918.  lft x[tilde_one]r=hround (x_move + 0.5w-3u);
  919.  rt x[tilde_five]l=hround (x_move + 0.5w+3u);
  920.  x[tilde_two]-x[tilde_one]=
  921.     x[tilde_three]-x[tilde_two]=
  922.     x[tilde_four]-x[tilde_three]=x[tilde_five]-x[tilde_four];
  923.  bot y[tilde_one]=bot y[tilde_four]l=y_move+vround(.75[x_height,h]-vair);
  924.  top y[tilde_two]r=top y[tilde_five]=h+y_move;
  925.  y[tilde_three]=.5[y[tilde_two],y[tilde_four]];
  926.  filldraw stroke
  927.    z[tilde_one]e{up}...
  928.      z[tilde_two]e{right}..
  929.      z[tilde_three]e..
  930.      {right}z[tilde_four]e...{up}z[tilde_five]e; fi % stroke
  931. enddef;
  932.  
  933. %
  934. vardef uppercase_tilde(expr x_move,y_move,tilde_one,tilde_two,tilde_three,
  935.      tilde_four,tilde_five)=
  936. h':=min(asc_height,10/7x_height+.5dot_size);
  937. if serifs: numeric theta;
  938.  theta=angle(1/6(
  939.     6u if monospace: /expansion_factor fi-vair),
  940.       1/4(h'-x_height));
  941.  pickup crisp.nib;
  942.  numeric mid_width; mid_width=.4[vair,stem];
  943.  pos[tilde_one](vair,theta+90);
  944.  pos[tilde_two](vair,theta+90);
  945.  pos[tilde_three](vair,theta+90);
  946.  pos[tilde_four](vair,theta+90);
  947.  z[tilde_two]-z[tilde_one]=
  948.     z[tilde_four]-z[tilde_three]=(mid_width-crisp)*dir theta;
  949.  lft x[tilde_one]r=hround(x_move+0.5w-3u if monospace: /expansion_factor fi);
  950.  rt x[tilde_four]l=hround(x_move+0.5w+3u if monospace: /expansion_factor fi);
  951.  top y[tilde_four]r=h;
  952.  bot y[tilde_one]l=vround(bot y[tilde_one]l+h-h'+
  953.     min(2/3[x_height,h'],y[tilde_three]l-.25vair)-top y[tilde_one]r);
  954.  pair delta;
  955.  ypart delta=3(y[tilde_three]l-y[tilde_one]l);
  956.  delta=whatever*dir theta;
  957.  filldraw z[tilde_one]l..
  958.    controls(z[tilde_one]l+
  959.     delta)and(z[tilde_three]l-delta)..z[tilde_three]l..z[tilde_four]l
  960.   --z[tilde_four]r..
  961.      controls(z[tilde_four]r-delta)and(z[tilde_two]r+delta)..
  962.      z[tilde_two]r..z[tilde_one]r--cycle;  % stroke
  963. else:
  964.  pickup fine.nib;
  965.  pos[tilde_one](vair,180);
  966.  pos[tilde_two](vair,90);
  967.  pos[tilde_three](.5[vair,slab],90);
  968.  pos[tilde_four](vair,90);
  969.  pos[tilde_five](vair,180);
  970.  lft x[tilde_one]r=w-rt x[tilde_five]l=hround 1.5u+0.5(w-9u);
  971.  x[tilde_two]-x[tilde_one]=
  972.     x[tilde_three]-x[tilde_two]=
  973.     x[tilde_four]-x[tilde_three]=x[tilde_five]-x[tilde_four];
  974.  bot y[tilde_one]=bot y[tilde_four]l=vround(.75[x_height+acc_height,h]-vair);
  975.  top y[tilde_two]r=top y[tilde_five]=h;
  976.  y[tilde_three]=.5[y[tilde_two],y[tilde_four]];
  977.  filldraw stroke
  978.    z[tilde_one]e{up}...
  979.      z[tilde_two]e{right}..
  980.      z[tilde_three]e..
  981.      {right}z[tilde_four]e...{up}z[tilde_five]e; fi % stroke
  982. enddef;
  983. %
  984. %
  985. %
  986. vardef lowercase_umlaut(expr x_move,y_move,umlaut_one,umlaut_two,
  987.    umlaut_three,umlaut_four) =
  988. dot_diam:=max(tiny.breadth,hround(max(dot_size,cap_curve)-2stem_corr));
  989. pickup tiny.nib;
  990. pos[umlaut_one](dot_diam,0);
  991. pos[umlaut_two](dot_diam,90);
  992. x[umlaut_one]=x[umlaut_two]=x_move+.5w-1.75u if monospace:/expansion_factor fi ;
  993. top y[umlaut_two]r=vround(x_height+dot_height#*hppp);
  994. y[umlaut_one]=y_move+.5[y[umlaut_two]l,y[umlaut_two]r];
  995. dot([umlaut_one],[umlaut_two]);  % left dot
  996. pos[umlaut_three](dot_diam,0);
  997. penpos[umlaut_four](y[umlaut_two]r-y[umlaut_two]l,90);
  998. y[umlaut_three]=y[umlaut_four]=y[umlaut_one];
  999. x[umlaut_three]=x[umlaut_four]=x[umlaut_one]
  1000.      +3.5u if monospace: /expansion_factor fi ;
  1001. dot([umlaut_three],[umlaut_four]);  % right dot
  1002. enddef;
  1003. %
  1004. vardef uppercase_umlaut(expr x_move,y_move,umlaut_one,umlaut_two,
  1005.    umlaut_three,umlaut_four) =
  1006. dot_diam:=max(tiny.breadth,hround(max(dot_size,cap_curve)-2stem_corr));
  1007. pickup tiny.nib;
  1008. pos[umlaut_one](dot_diam,0);
  1009. pos[umlaut_two](dot_diam,90);
  1010. x[umlaut_one]=x[umlaut_two]=x_move+.5w-1.75u if monospace:/expansion_factor fi ;
  1011. top y[umlaut_two]r=vround(cap_height+dot_height#*hppp);
  1012. y[umlaut_one]=y_move+.5[y[umlaut_two]l,y[umlaut_two]r];
  1013. dot([umlaut_one],[umlaut_two]);  % left dot
  1014. pos[umlaut_three](dot_diam,0);
  1015. penpos[umlaut_four](y[umlaut_two]r-y[umlaut_two]l,90);
  1016. y[umlaut_three]=y[umlaut_four]=y[umlaut_one];
  1017. x[umlaut_three]=x[umlaut_four]=x[umlaut_one]
  1018.      +3.5u if monospace: /expansion_factor fi ;
  1019. dot([umlaut_three],[umlaut_four]);  % right dot
  1020. enddef;
  1021. %
  1022. %
  1023. vardef lowercase_circle(expr
  1024.        x_center,y_center,circ_one,circ_two,circ_three,circ_four)=
  1025. numeric circ_hair,circ_vair;
  1026. circ_hair=hround min(hair,u if monospace: /expansion_factor fi +.5);
  1027. circ_vair=vround min(vair,(h-x_height)/6+.5);
  1028. penpos[circ_one](circ_vair,90); penpos[circ_three](circ_vair,-90);
  1029. penpos[circ_two](circ_hair,180); penpos[circ_four](circ_hair,0);
  1030. x[circ_one]=x[circ_three]=x_center; %
  1031. x[circ_two]r=hround(x[circ_one]-1.5u-.5circ_hair);
  1032. x[circ_four]r=hround(x[circ_one]+1.5u+.5circ_hair);
  1033. y[circ_one]r=h+apex_o;
  1034. y[circ_two]=y[circ_four]=.5[y[circ_one],y[circ_three]];
  1035. y[circ_three]l=vround y_center; % (1/3[x_height,h]+apex_o);
  1036. penstroke pulled_arc.e([circ_one],[circ_two])
  1037.  & pulled_arc.e([circ_two],[circ_three])
  1038.  & pulled_arc.e([circ_three],[circ_four])
  1039.  & pulled_arc.e([circ_four],[circ_one]) & cycle;  % bowl
  1040. enddef;
  1041. %
  1042. vardef uppercase_circle(expr
  1043.        x_center,y_move,circ_one,circ_two,circ_three,circ_four)=
  1044. numeric circ_hair,circ_vair;
  1045. circ_hair=hround min(hair,u if monospace: /expansion_factor fi +.5);
  1046. circ_vair=vround vair; % min(vair,(h-x_height)/6+.5);
  1047. penpos[circ_one](circ_vair,90); penpos[circ_three](circ_vair,-90);
  1048. penpos[circ_two](circ_hair,180); penpos[circ_four](circ_hair,0);
  1049. x[circ_one]=x[circ_three]=x_center; % .5w;
  1050. x[circ_two]r
  1051.     = hround(x[circ_one]-1.5u if monospace: /expansion_factor fi -.5circ_hair);
  1052. x[circ_four]r
  1053.     = hround(x[circ_one]+1.5u if monospace: /expansion_factor fi +.5circ_hair);
  1054. y[circ_one]r=h+apex_o;
  1055. y[circ_two]=y[circ_four]=.5[y[circ_one],y[circ_three]];
  1056. y[circ_three]l=vround y_move; % (1/3[x_height,h]+apex_o);
  1057. penstroke pulled_arc.e([circ_one],[circ_two])
  1058.  & pulled_arc.e([circ_two],[circ_three])
  1059.  & pulled_arc.e([circ_three],[circ_four])
  1060.  & pulled_arc.e([circ_four],[circ_one]) & cycle;  % bowl
  1061. enddef;
  1062. %
  1063. %
  1064. vardef lowercase_cedilla (expr x_center,y_move,
  1065.    cedi_one,cedi_two,cedi_three,cedi_four,cedi_five) =
  1066. x[cedi_one]=x_center; % .5w+.5u;
  1067. if serifs:
  1068.  pickup crisp.nib;
  1069.  pos[cedi_one](stem,0);
  1070.  pos[cedi_two](stem,0);
  1071.  pos[cedi_three](vair,90);
  1072.  pos[cedi_four](stem,0);
  1073.  pos[cedi_five](vair,-90);
  1074.  x[cedi_one]=x[cedi_two];
  1075.  z[cedi_three]l=z[cedi_two]l;
  1076.  x[cedi_four]=x[cedi_two]+1.5u;
  1077.  x[cedi_five]=x[cedi_three]-1.5u;
  1078.  bot y[cedi_one]=0;
  1079.  bot y[cedi_two]=-vround 2/7d-o;
  1080.  y[cedi_four]=.5[y[cedi_three],y[cedi_five]];
  1081.  bot y[cedi_five]=-d-o;
  1082.  filldraw stroke z[cedi_one]e--z[cedi_two]e;  % stem
  1083.  filldraw stroke z[cedi_three]e{right}...
  1084.    z[cedi_four]e{down}...{left}z[cedi_five]e;  % hook
  1085. else: pickup fine.nib; pos[cedi_one](vair,0); top y[cedi_one]=-o-2;
  1086.  pos[cedi_two](.5[vair,stem],0);
  1087.  bot y[cedi_two]=-d-o; x[cedi_two]=x[cedi_one]-1.25u;
  1088.  filldraw stroke z[cedi_one]e--z[cedi_two]e; fi  % diagonal
  1089. enddef;
  1090. %
  1091. vardef uppercase_cedilla(expr x_center,y_move,
  1092.   cedi_one,cedi_two,cedi_three,cedi_four,cedi_five) =
  1093. x[cedi_one]=x_center;;
  1094. if serifs:
  1095.  pickup crisp.nib;
  1096.  pos[cedi_one](stem,0);
  1097.  pos[cedi_two](stem,0);
  1098.  pos[cedi_three](vair,90);
  1099.  pos[cedi_four](stem,0);
  1100.  pos[cedi_five](vair,-90);
  1101.  x[cedi_one]=x[cedi_two];
  1102.  z[cedi_three]l=z[cedi_two]l;
  1103.  x[cedi_four]=x[cedi_two]+1.5u if monospace: /expansion_factor fi;
  1104.  x[cedi_five]=x[cedi_three]-1.5u if monospace: /expansion_factor fi;
  1105.  top y[cedi_one]=y_move;
  1106.  bot y[cedi_two]=-vround 2/7d-o;
  1107.  y[cedi_four]=.5[y[cedi_three],y[cedi_five]];
  1108.  bot y[cedi_five]=-d-o;
  1109.  filldraw stroke z[cedi_one]e--z[cedi_two]e;  % stem
  1110.  filldraw stroke z[cedi_three]e{right}...
  1111.    z[cedi_four]e{down}...{left}z[cedi_five]e;  % hook
  1112. else: pickup fine.nib; pos[cedi_one](vair,0);
  1113.  top y[cedi_one]=-o-2;
  1114.  pos[cedi_two](.5[vair,stem],0);
  1115.  bot y[cedi_two]=-d-o; x[cedi_two] =
  1116.     x[cedi_one]-1.25u if monospace: /expansion_factor fi;
  1117.  filldraw stroke z[cedi_one]e--z[cedi_two]e; fi  % diagonal
  1118. enddef;
  1119. %
  1120. %
  1121. vardef lowercase_breve(expr x_center,y_move,breve_one,breve_two,breve_three)=
  1122. pickup crisp.nib; pos[breve_one](vair,-180);
  1123. pos[breve_three](vair,0);
  1124. top y[breve_one]=top y[breve_three]=h;
  1125. x[breve_two]=x_center;
  1126. lft x[breve_one]r=hround(x[breve_two]-2.5u
  1127.    if monospace: /expansion_factor fi -0.5vair);
  1128. rt x[breve_three]r=hround(x[breve_two]+2.5u
  1129.    if monospace: /expansion_factor fi +0.5vair);
  1130. numeric mid_thickness; mid_thickness=vround 1/3[vair,stem];
  1131. pos[breve_two](mid_thickness,-90);
  1132. bot y[breve_two]r=
  1133.    vround max(x_height+o+tiny,1/3[x_height,h]+o-.5mid_thickness);
  1134. filldraw stroke z[breve_one]e{down}...
  1135.          z[breve_two]e{right}...{up}z[breve_three]e;  % stroke
  1136. enddef;
  1137. %
  1138. vardef uppercase_breve (expr x_center,y_move,breve_one,
  1139.    breve_two,breve_three)=
  1140. pickup crisp.nib; pos[breve_one](vair,-180);
  1141. pos[breve_three](vair,0);
  1142. top y[breve_one]=top y[breve_three]=h+y_move;
  1143. x[breve_two]=hround x_center;
  1144. x[breve_two]-rt x[breve_one]l
  1145.   =(lft x[breve_three]l)-x[breve_two]
  1146.   =hround (2.5u if monospace: /expansion_factor fi -.5vair);
  1147. numeric mid_thickness;
  1148. mid_thickness=vround min(1/3[vair,stem],.5acc_height);
  1149. pos[breve_two](mid_thickness,-90);
  1150. bot y[breve_two]r=
  1151.    vround y_move+max(
  1152.       min(cap_height+o+max(tiny,0.5mid_thickness),cap_height+0.3acc_height),
  1153.       1/3[cap_height,min(asc_height,2x_height)]+o-.5mid_thickness);
  1154. filldraw stroke z[breve_one]e{down}...z[breve_two]e{right}...
  1155.      {up}z[breve_three]e;  % stroke
  1156. enddef;
  1157.  
  1158. %
  1159. vardef lowercase_hachek(expr x_center,y_move,
  1160.     hat_zero,hat_one,hat_two,hat_three,hat_four)=
  1161. %
  1162. h':=vround x_height+acc_height; % height of circumflex being inverted
  1163. hx:=vround acc_height+.75[x_height,min(asc_height,2x_height)];
  1164. if serifs:
  1165.  pickup crisp.nib;
  1166.  pos[hat_two]'(.5[vair,curve],90);
  1167.  top y[hat_two]'r=.75[x_height,min(asc_height,2x_height)]-x_height;
  1168.  pos[hat_two](.5[vair,curve],90);
  1169.  x[hat_two]=x_center;
  1170.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi;
  1171.  x[hat_three]=2x[hat_two]-x[hat_one];
  1172.  top y[hat_one]=top y[hat_three]
  1173.     = max(h+y_move-0.25(min(2x_height,asc_height)-x_height),
  1174.          h-.7acc_height+.5y[hat_two]'r);
  1175.  y[hat_one]-y[hat_two]=.5y[hat_two]'r;
  1176.  pos[hat_one](hair,angle(z[hat_two]-z[hat_one])+90);
  1177.  pos[hat_three](hair,angle(z[hat_three]-z[hat_two])+90);
  1178.  filldraw stroke z[hat_one]e--z[hat_two]e--z[hat_three]e;  % diagonals
  1179. else:
  1180.  pickup fine.nib; pos[hat_one](vair,0);
  1181.  pos[hat_three](vair,0);
  1182.  x[hat_two]-x[hat_one]=x[hat_three]-x[hat_two];
  1183.  pos[hat_two](stem,0);
  1184.  bot y[hat_two]=vround(y_move+1/12[x_height,min(asc_height,2x_height)]+o);
  1185.  x[hat_two]=x_center;
  1186.  top y[hat_one]=top y[hat_three]
  1187.   = y_move+.75[x_height,min(asc_height,2x_height)]+o;
  1188.  lft x[hat_one]l=hround(rt x[hat_two]r-0.5vair
  1189.    -3.25u if monospace: /expansion_factor fi);
  1190.  z[hat_zero]=
  1191.     whatever[z[hat_one]r,z[hat_two]r]=whatever[z[hat_two]l,z[hat_three]l];
  1192.  y[hat_four]l=y[hat_four]r=y[hat_two];
  1193.  x[hat_four]l=good.x .2[x[hat_two]l,x[hat_two]];
  1194.  x[hat_four]r-x[hat_two]=x[hat_two]-x[hat_four]l;
  1195.  filldraw z[hat_four]l--z[hat_one]l--
  1196.           z[hat_one]r--z[hat_zero]--
  1197.           z[hat_three]l--z[hat_three]r--
  1198.           z[hat_four]r--cycle; fi  % diagonals
  1199. enddef;
  1200. %
  1201. vardef uppercase_hachek(expr x_center,y_move,
  1202.     hat_zero,hat_one,hat_two,hat_three,hat_four)=
  1203. %
  1204. h':=vround cap_height+acc_height; % height of circumflex being inverted
  1205. hx:=vround acc_height+.75[x_height,min(asc_height,2x_height)];
  1206. hy:=cap_height-x_height+.75[x_height,min(asc_height,2x_height)];
  1207. if serifs:
  1208.  pickup crisp.nib;
  1209.  pos[hat_two]'(.5[vair,curve],90);
  1210.  top y[hat_two]'r=.75[x_height,min(asc_height,2x_height)]-x_height;
  1211.  pos[hat_two](.5[vair,curve],90);
  1212.  x[hat_two]=x_center;
  1213.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi;
  1214.  x[hat_three]=2x[hat_two]-x[hat_one];
  1215.  top y[hat_one]=top y[hat_three]
  1216.     =max(h+y_move-0.25(min(2x_height,asc_height)-x_height),
  1217.          h-.7acc_height+.5y[hat_two]'r);
  1218.  y[hat_one]-y[hat_two]=.5y[hat_two]'r;
  1219.  pos[hat_one](hair,angle(z[hat_two]-z[hat_one])+90);
  1220.  pos[hat_three](hair,angle(z[hat_three]-z[hat_two])+90);
  1221.  filldraw stroke z[hat_one]e--z[hat_two]e--z[hat_three]e;  % diagonals
  1222. else:
  1223.  pickup fine.nib; pos[hat_one](vair,0);
  1224.  pos[hat_three](vair,0);
  1225.  x[hat_two]-x[hat_one]=x[hat_three]-x[hat_two];
  1226.  pos[hat_two](stem,0);
  1227.  bot y[hat_two]=vround(1/12[cap_height,h']+o);
  1228.  x[hat_two]=x_center;
  1229.  top y[hat_one]=top y[hat_three]=hy+o;
  1230.  lft x[hat_one]l=hround(rt x[hat_two]r-0.5vair
  1231.    -3.25u if monospace: /expansion_factor fi);
  1232.  z[hat_zero]=
  1233.     whatever[z[hat_one]r,z[hat_two]r]=whatever[z[hat_two]l,z[hat_three]l];
  1234.  y[hat_four]l=y[hat_four]r=y[hat_two];
  1235.  x[hat_four]l=good.x .2[x[hat_two]l,x[hat_two]];
  1236.  x[hat_four]r-x[hat_two]=x[hat_two]-x[hat_four]l;
  1237.  filldraw z[hat_four]l--z[hat_one]l--
  1238.           z[hat_one]r--z[hat_zero]--
  1239.           z[hat_three]l--z[hat_three]r--
  1240.           z[hat_four]r--cycle; fi  % diagonals
  1241. enddef;
  1242.  
  1243. %
  1244. vardef lowercase_ogonek(expr x_move,y_move,ogon_one,ogon_two,ogon_three) =
  1245. x[ogon_one]r=x_move;
  1246.  pickup crisp.nib;
  1247.  pos[ogon_one](
  1248.  if currentbreadth<0.9vair: 0.9vair else: currentbreadth+eps fi,-60);
  1249.  pos[ogon_two](stem,0);
  1250.  pos[ogon_three](vair,145);
  1251.  x[ogon_two]=x[ogon_one]-2.5u if monospace: / expansion_factor fi ;
  1252.  x[ogon_three]=x[ogon_one]+0.5u if monospace: / expansion_factor fi ;
  1253.  bot y[ogon_one]r = y_move;
  1254.  bot y[ogon_three]=0.5(-d-o)+y_move;  %0.4
  1255.  bot y[ogon_two]=0.5(-d-o)+y_move;
  1256.  filldraw stroke z[ogon_one]e{dir 225}...
  1257.    z[ogon_two]e{dir -110}...{dir 60}z[ogon_three]e;  % hook
  1258. enddef;
  1259. %
  1260. %
  1261. vardef lowercase_humlaut
  1262.    (expr humlaut_one,humlaut_two,humlaut_three,humlaut_four) =
  1263. y[humlaut_three]=y[humlaut_one]; y[humlaut_four]=y[humlaut_two];
  1264. if serifs:
  1265.     x[humlaut_three]-x[humlaut_one]=hround 3.75uu;
  1266.     x[humlaut_four]-x[humlaut_two]=hround 3.4uu;
  1267.     pickup crisp.nib;
  1268.     if monospace:
  1269.        x[humlaut_three]+.5stem=hround(.5w+4.2uu); x[humlaut_two]=.5w-2.1uu;
  1270.     else:
  1271.        x[humlaut_three]+.5stem=hround(.5w+4.8uu); x[humlaut_two]=.5w-2.1uu;
  1272.     fi;
  1273.     y[humlaut_one]+.5stem=h;
  1274.     y[humlaut_two]=max(.7[h,x_height],x_height+o+hair);
  1275.     numeric theta; theta=angle(z[humlaut_two]-z[humlaut_one])+90;
  1276.     pos[humlaut_one](stem,theta); pos[humlaut_two](hair,theta);
  1277.     pos[humlaut_three](stem,theta); pos[humlaut_four](hair,theta);
  1278.     filldraw circ_stroke z[humlaut_one]e--z[humlaut_two]e;  % left diagonal
  1279.     filldraw circ_stroke z[humlaut_three]e--z[humlaut_four]e;  % right diagonal
  1280. else:
  1281.     pickup fine.nib;
  1282.     pos[humlaut_two](1.1vair,0); pos[humlaut_four](1.1vair,0);
  1283.     if stem<1.8uu:
  1284.        pos[humlaut_one](1.3stem,0); pos[humlaut_three](1.3stem,0);
  1285.        rt x[humlaut_three]r=hround(.5w+4.4uu);
  1286.        x[humlaut_three]-x[humlaut_one]=hround 3.05uu;
  1287.      else:
  1288.        pos[humlaut_one](1.2stem,0); pos[humlaut_three](1.2stem,0);
  1289.        rt x[humlaut_three]r=hround(.5w+4.65uu);
  1290.        x[humlaut_three]-x[humlaut_one]=hround 3.55uu;
  1291.      fi;
  1292.      lft x[humlaut_four]l=hround(.5w+1uu-.5vair);
  1293.      x[humlaut_four]-x[humlaut_two]=hround 2.7uu;
  1294.      top y[humlaut_one]=h;
  1295.      bot y[humlaut_two]=vround .65[h,x_height];
  1296.      filldraw stroke z[humlaut_one]e--z[humlaut_two]e;  % left diagonal
  1297.      filldraw stroke z[humlaut_three]e--z[humlaut_four]e;
  1298.  fi  % right diagonal
  1299. enddef;
  1300. %
  1301. %
  1302. vardef uppercase_humlaut
  1303.   (expr x_center, y_move, humlaut_one,humlaut_two,humlaut_three,humlaut_four) =
  1304. y[humlaut_three]=y[humlaut_one]; y[humlaut_four]=y[humlaut_two];
  1305. if serifs:
  1306.     x[humlaut_three]-x[humlaut_one] =
  1307.        hround 3.75u if monospace: /expansion_factor fi;
  1308.     x[humlaut_four]-x[humlaut_two] =
  1309.       hround 3.4u if monospace: /expansion_factor fi;
  1310.     pickup crisp.nib;
  1311.     x[humlaut_three]+.5stem =
  1312.          hround(x_center+4.8u if monospace: /expansion_factor fi);
  1313.     x[humlaut_two]=x_center-2.1u;
  1314.     y[humlaut_one]+.5stem=h;
  1315.     y[humlaut_two]=max(.7[h,cap_height],cap_height+o+hair);
  1316.     numeric theta; theta=angle(z[humlaut_two]-z[humlaut_one])+90;
  1317.     pos[humlaut_one](stem,theta); pos[humlaut_two](hair,theta);
  1318.     pos[humlaut_three](stem,theta); pos[humlaut_four](hair,theta);
  1319.     filldraw circ_stroke z[humlaut_one]e--z[humlaut_two]e;  % left diagonal
  1320.     filldraw circ_stroke z[humlaut_three]e--z[humlaut_four]e;  % right diagonal
  1321. else:
  1322.     pickup fine.nib;
  1323.     pos[humlaut_two](1.1vair,0); pos[humlaut_four](1.1vair,0);
  1324.     if stem<1.8u:
  1325.        pos[humlaut_one](1.3stem,0); pos[humlaut_three](1.3stem,0);
  1326.        rt x[humlaut_three]r =
  1327.           hround(x_center+4.4u if monospace: /expansion_factor fi);
  1328.        x[humlaut_three]-x[humlaut_one] =
  1329.          hround 3.05u if monospace: /expansion_factor fi;
  1330.      else:
  1331.        pos[humlaut_one](1.2stem,0); pos[humlaut_three](1.2stem,0);
  1332.        rt x[humlaut_three]r =
  1333.           hround(x_center+4.65u if monospace: /expansion_factor fi);
  1334.        x[humlaut_three]-x[humlaut_one] =
  1335.           hround 3.55u if monospace: /expansion_factor fi;
  1336.      fi;
  1337.      lft x[humlaut_four]l =
  1338.         hround(x_center+1u if monospace: /expansion_factor fi-.5vair);
  1339.      x[humlaut_four]-x[humlaut_two] =
  1340.         hround 2.7u if monospace: /expansion_factor fi;
  1341.      top y[humlaut_one]=h;
  1342.      bot y[humlaut_two]=vround .65[h,cap_height];
  1343.      filldraw stroke z[humlaut_one]e--z[humlaut_two]e;  % left diagonal
  1344.      filldraw stroke z[humlaut_three]e--z[humlaut_four]e;
  1345.  fi  % right diagonal
  1346. enddef;
  1347.  
  1348. %
  1349. % some extra font parameter
  1350. %
  1351. def font_character_set expr x = fontdimen  8: x enddef;
  1352. def font_baselineskip  expr x = fontdimen  9: x enddef;
  1353. def font_acc_height    expr x = fontdimen 10: x enddef;
  1354. def font_cap_height    expr x = fontdimen 11: x enddef;
  1355. def font_asc_height    expr x = fontdimen 12: x enddef;
  1356. def font_rule_thickness expr x = fontdimen 13: x enddef;
  1357.  
  1358.  
  1359.  
  1360. %
  1361. %      XXXXXXX       The following routines generate the parameter
  1362. %      X     X       sets by extrapolation
  1363. %      X     X
  1364. %      X     X
  1365. %      X     X
  1366. %   XXXX     XXXX
  1367. %    X         X
  1368. %     X       X
  1369. %      X     X
  1370. %       X   X
  1371. %        X X
  1372. %         X
  1373. %
  1374. %
  1375. %                     needed variables
  1376. %
  1377.  
  1378. vardef simple_gendef@#(text aa)(text t)=
  1379. string s[];
  1380. s1:="";
  1381. s2:=str @#;
  1382. index:=1;
  1383. forsuffixes $=t: ydata[index]:=$ if s1<>s2: *@# fi;
  1384.                  index:=index+1;
  1385. endfor;
  1386. if numpoints>(index-1): errmessage "Missing parameter"; message str aa; fi;
  1387. if numpoints<(index-1): errmessage "too much parameter"; message str aa; fi;
  1388. aa:=ydata[merke];
  1389. if gencheck: message str aa fi;
  1390. enddef;
  1391.  
  1392. vardef extended_gendef@#(text aa)(text t)=
  1393. string s[];
  1394. s1:="";
  1395. s2:=str @#;
  1396. index:=1;
  1397. forsuffixes $=t: ydata[index]:=$ if s1<>s2: *@# fi;
  1398.                  index:=index+1;
  1399. endfor;
  1400. if numpoints>(index-1): errmessage "missing parameter"; message str aa; fi;
  1401. if numpoints<(index-1): errmessage "too much parameter"; message str aa; fi;
  1402. if gensize>basedata[numpoints]:
  1403.    numeric hilf [];
  1404.    hilf[1]:=(ydata[numpoints]-ydata[numpoints-1])/(basedata[numpoints]-basedata[numpoints-1]);
  1405.    hilf[2]:=(ydata[numpoints]-ydata[numpoints-2])/(basedata[numpoints]-basedata[numpoints-2]);
  1406.    hilf[3]:=ydata[numpoints]-hilf1*basedata[numpoints];
  1407.    hilf[4]:=ydata[numpoints]-hilf2*basedata[numpoints];
  1408.    spy:=(hilf[1]*gensize+hilf[3])/2+(hilf[2]*gensize+hilf[4])/2;
  1409.    aa:=spy;
  1410. else:
  1411. for index = 1 upto numpoints-1:
  1412.     interval[index]:=basedata[index+1]-basedata[index];
  1413. endfor;
  1414.  
  1415. for index=1 upto numpoints:
  1416.     spline[1][index]:=ydata[index]; endfor;
  1417.  
  1418. for index=2 upto numpoints-1:
  1419.     alpha[index]:=3*((spline[1][index+1]*interval[index-1])%
  1420.                    -(spline[1][index]*(basedata[index+1]-basedata[index-1]))%
  1421.                    +(spline[1][index-1]*interval[index]))%
  1422.                    /(interval[index-1]*interval[index]);
  1423. endfor;
  1424.  
  1425. spl[1]:=0;
  1426. spmu[1]:=0;
  1427. spz[1]:=0;
  1428. for index=2 upto numpoints-1:
  1429.     spl[index]:=2*(basedata[index+1]-basedata[index-1])%
  1430.                  -interval[index-1]*spmu[index-1];
  1431.     spmu[index]:=interval[index]/spl[index];
  1432.     spz[index]:=(alpha[index]-interval[index-1]*spz[index-1])/spl[index];
  1433. endfor;
  1434.  
  1435. spline[3][numpoints]:=0;
  1436. for index=numpoints-1 downto 1:
  1437.     spline[3][index]:=spz[index]-spmu[index]*spline[3][index+1];
  1438. endfor;
  1439. for index=numpoints -1 downto 1:
  1440.     spline[2][index]:=(spline[1][index+1]-spline[1][index])/interval[index]%
  1441.              -interval[index]*(spline[3][index+1]*spline[3][index])/3;
  1442.     spline[4][index]:=(spline[3][index+1]-spline[3][index])/(3*interval[index]);
  1443. endfor;
  1444. location:=1;
  1445. for term=1 upto numpoints-1:
  1446.     if gensize > basedata[term]: location:=term; fi
  1447. endfor;
  1448.  
  1449. spx:=gensize-basedata[location];
  1450. spy:=((spline[4][location]*spx+spline[3][location])*spx+spline[2][location])*spx+spline[1][location];
  1451. aa:=spy; fi;
  1452. if gencheck: message str aa fi;
  1453. enddef;
  1454.  
  1455. vardef basedef(text t)=
  1456. boolean basevalue;
  1457. boolean gencheck;
  1458. numeric index;
  1459. numeric ergbnis;
  1460. numeric location;
  1461. numeric term;
  1462. numeric numpoints;
  1463. numeric spx;
  1464. numeric spy;
  1465. numeric basedata[];
  1466. numeric interval[];
  1467. numeric alpha[];
  1468. numeric spl[];
  1469. numeric spmu[];
  1470. numeric spz[];
  1471. numeric ydata[];
  1472. numeric spline[][];
  1473. basevalue:=false;
  1474. gencheck:=false;
  1475.  
  1476. index:=1;
  1477. forsuffixes $=t: basedata[index]:=$;
  1478.                  if $=gensize: basevalue:=true; merke:=index; fi;
  1479.                  index:=index+1;
  1480. endfor;
  1481. numpoints:=index-1;
  1482. if numpoints<3: errmessage "Nicht genug Referenzpunkte"; fi
  1483. if basevalue: def gendef=simple_gendef enddef; else:
  1484.               def gendef=extended_gendef enddef; fi
  1485. enddef;
  1486.  
  1487. endinput;
  1488.